home *** CD-ROM | disk | FTP | other *** search
/ com!online 2005 May / com_0505_1.iso / opensource / top10 / amc_install.exe / {app} / Scripts / StopKlatka (PL).ifs < prev    next >
Encoding:
Text File  |  2004-08-09  |  13.0 KB  |  399 lines

  1. // GETINFO SCRIPTING
  2. // StopKlatka
  3.  
  4. (***************************************************
  5.  *  Movie importation script for:                  *
  6.  *  Stopklatka.pl (PL), http://www.stopklatka.pl   *
  7.  *                                                 *
  8.  *  (c) 2003 Maciej Galkowski                      *
  9.  * send bugs and reports to:                       *
  10.  *                         m.galkowski@interia.pl  *
  11.  *                                                 *
  12.  *  For use with Ant Movie Catalog 3.4.1 or newer  *
  13.  *  www.antp.be/software/moviecatalog              *
  14.  *                                                 *
  15.  *  This program is free software; you can         *
  16.  *  redistribute it and/or modify it under the     *
  17.  *  terms of the GNU General Public License as     *
  18.  *  published by the Free Software Foundation;     *
  19.  *  either version 2 of the License, or (at your   *
  20.  *  option) any later version.                     *
  21.  *  Based on All Movie script                      *
  22.  ***************************************************)
  23.  
  24. program StopKlatka;
  25. var
  26.   MovieName: string;
  27.   ImageFrom: Integer;
  28.   
  29.   
  30. procedure SetOPT();
  31. begin
  32. //OPTIONS
  33. //  ImageFrom - 0 = from StopKlatka.pl
  34. //              1 = from Amazon.com
  35. //              2 = from Amazon.com, then Stopklatka.pl if not found  (default)
  36. ImageFrom := 2;
  37. //END OPTIONS
  38. end;
  39.  
  40. // simple string procedures
  41. function StringReplaceAll(S, Old, New: string): string;
  42. begin
  43.   while Pos(Old, S) > 0 do
  44.     S := StringReplace(S, Old, New);
  45.   Result := S;
  46. end;
  47. procedure CutAfter(var Str: string; Pattern: string);
  48. begin
  49.   Str := Copy(str, Pos(Pattern, Str) + Length(Pattern), Length(Str));
  50. end;
  51. procedure CutBefore(var Str: string; Pattern: string);
  52. begin
  53.   Str := Copy(Str, Pos(Pattern, Str), Length(Str));
  54. end;
  55.  
  56. // Loads and analyses page from internet (list of movies or direct hit)
  57. procedure AnalyzePage(Address: string);
  58. var
  59.   Page: TStringList;
  60. begin
  61.   Page := TStringList.Create;
  62.   Page.Text := GetPage(Address);
  63.   // movie list
  64.   if Pos('Nic nie znaleziono', Page.Text) > 0 then
  65.   begin
  66.     ShowMessage('Nic nie znaleziono');
  67.   end
  68.   else
  69.   begin
  70.     PickTreeClear;
  71.     PickTreeAdd('Wyniki szukania', '');
  72.     AddMoviesTitles(Page);
  73.     if PickTreeExec(Address) then
  74.       AnalyzeMoviePage(Address);
  75.   end;
  76. end;
  77.  
  78. // Extracts movie details from page
  79. procedure AnalyzeMoviePage(Address: string);
  80. var
  81.   Page: string;
  82.   Value: string;
  83.   Title: string;
  84. begin
  85.   Page := GetPage(Address);
  86.   
  87.   // Title
  88.   if Pos('<h2>',Page) > 0 then
  89.   begin
  90.     SetField(fieldOriginalTitle, GetStringFromHTML(Page, '<h2>', '(', ')</h2>',1));
  91.   end;
  92.   SetField(fieldTranslatedTitle, GetStringFromHTML(Page, '<h1>', '', '</h1>',1));
  93.  
  94.   // Year
  95.   SetField(fieldYear, GetStringFromHTML(Page, '>rok produkcji:', '<b>', '</tr>',1));
  96.  
  97.   // Country
  98.   Value := GetStringFromHTML(Page, '>kraj:', '<b>', '</tr>',1);
  99.   if Pos('/', Value) > 0 then
  100.   begin
  101.     Value := StringReplaceAll(Value, ' ','');
  102.   end;
  103.   SetField(fieldCountry, Value);
  104.  
  105.   // Director
  106.   SetField(fieldDirector, GetStringFromHTML(Page, '>re┐yseria:', '<b>', '</tr>',1));
  107.  
  108.   // Genre -> category
  109.   Value := GetStringFromHTML(Page, '>gatunek:', '<b>', '</tr>',1);
  110.   if Pos('/', Value) > 0 then
  111.   begin
  112.     Value := StringReplaceAll(Value, ' ','');
  113.   end;
  114.   SetField(fieldCategory, Value);
  115.   
  116.   //URL
  117.   SetField(fieldURL,Address);
  118.  
  119.   // Image
  120.   case ImageFrom of
  121.     0 :
  122.     begin
  123.       Value := GetStringFromHTML(Page, 'http://img.stopklatka.pl/film/', '', '0.jpg',1);
  124.       if Length(Value) > 0 then GetPicture(Value + '0.jpg', False);
  125.     end;
  126.     1:
  127.     begin
  128.        if GetStringFromHTML(Page, '<h2>', '', '</h2>',1) <> '' then
  129.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h2>', '', '</h2>',1));
  130.        else
  131.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h1>', '', '</h1>',1));
  132.        if Length(Value) > 0 then GetPicture(Value, False);
  133.     end;
  134.     2:
  135.     begin
  136.        if GetStringFromHTML(Page, '<h2>', '', '</h2>',1) <> '' then begin
  137.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h2>', '', '</h2>',1));
  138.           end
  139.        else begin
  140.           Value := AmazonImageImport(GetStringFromHTML(Page, '<h1>', '', '</h1>',1));
  141.           end
  142.        if Length(Value) > 0 then begin
  143.           GetPicture(Value, False);
  144.        end
  145.        else begin
  146.           Value := GetStringFromHTML(Page, 'http://img.stopklatka.pl/film/', '', '0.jpg',1);
  147.           if Length(Value) > 0 then GetPicture(Value + '0.jpg', False);
  148.        end
  149.     end
  150.   end; //case
  151.   
  152.   // Description
  153.   Value := GetStringFromHTML(Page, '<font  size=2 class="text2">', '', '</font>',1);
  154.   if Length(Value) > 0 then SetField(fieldDescription, Value);
  155.  
  156.   // remove trailing newline from description
  157.   Value := GetField(fieldDescription);
  158.   if Copy(Value, Length(Value) - 1, 2) = #13#10 then begin
  159.     Value := Copy(Value, 0, Length(Value) - 2);
  160.     SetField(fieldDescription, Value);
  161.   end;
  162.  
  163.   // Cast -> actors
  164.   SetField(fieldActors, GetStringFromHTML(Page, '>obsada:', '<b>', '</tr>',1));
  165.  
  166.   DisplayResults;
  167. end;
  168.  
  169. // Adds movie titles from search results to tree
  170. procedure AddMoviesTitles(ResultsPage: TStringList);
  171. var
  172.   Page: string;
  173.   MovieTitle, MovieAddress: string;
  174. begin
  175.   Page := ResultsPage.Text;
  176.   // Every movie entry begins with string "<a href="/film/film.asp?"
  177.   while Pos('<a href="/film/film.asp?', Page) > 0 do
  178.   begin
  179.     CutBefore(Page, '<a href="/film/film.asp?');
  180.     MovieAddress := 'http://www.stopklatka.pl' + GetStringFromHTML(Page, '<a', '"', '">',0);
  181.     MovieTitle := GetStringFromHTML(Page, '<a', '', ')',0);
  182.     MovieTitle := StringReplace(MovieTitle, ')', '),  ');
  183.     if Pos('<i>', MovieTitle) > 0 then
  184.     begin
  185.       MovieTitle := MovieTitle + ')';
  186.     end
  187.     else
  188.     begin
  189.       MovieTitle := GetStringFromHTML(MovieTitle, '<a', '', '(',0);
  190.     end;
  191.     HTMLRemoveTags(MovieTitle);
  192.     CutAfter(Page, '</font>');
  193.     // add movie to list
  194.     PickTreeAdd(MovieTitle, MovieAddress);
  195.   end;
  196. end;
  197.  
  198. // Extracts single movie detail (like director, genre) from page
  199. function GetStringFromHTML(Page, StartTag, CutTag, EndTag: string; RemoveTags: Integer): string;
  200. begin
  201.   Result := '';
  202.   // recognition tag - if present, extract detail from page, otherwise assume detail is not present
  203.   if Pos(StartTag, Page) > 0 then begin
  204.     CutBefore(Page, StartTag);
  205.     // optional cut tag helps finding right string in html page
  206.     if Length(CutTag) > 0 then
  207.       CutAfter(Page, CutTag);
  208.     // movie detail copied with html tags up to end string
  209.     Result := Copy(Page, 0, Pos(EndTag, Page) - 1);
  210.     // remove html tags (if needed) and decode html string
  211.     if RemoveTags > 0 then
  212.     begin
  213.       HTMLRemoveTags(Result);
  214.     end;
  215.     HTMLDecode(Result);
  216. //  ShowMessage('DEBUG: GetStringFromHTML - StartTag "'+StartTag+'", CutTag "'+CutTag+'", EndTag "'+EndTag+'", Result "'+Result+'" ___ '+Page);
  217.   end;
  218. end;
  219.  
  220. function AmazonImageImport(Title: string):string;
  221. var
  222.   AmazonPage: TStringList;
  223.   THolder, MovieName : string;
  224.   LineNr, i, CoverNum: Integer;
  225. begin
  226.   AmazonPage := TStringList.Create;
  227.   AmazonPage.Text := GetPage('http://www.amazon.com/exec/obidos/search-handle-url/index=dvd&field-title=' + StringReplace(UrlEncode(Title),'+', '%20'));
  228.   if (FindLine('Amazon.com: DVD:',AmazonPage,1) <> -1) and
  229.      (FindLine('dvd-no-image',AmazonPage,1) = -1) then
  230.     begin
  231.       LineNr := FindLine('<input type="hidden" name="asin.',AmazonPage,1);
  232.       AmazonImageImport := 'http://images.amazon.com/images/P/' + AsinParse(AmazonPage.Getstring(LineNr)) + '.01.LZZZZZZZ.jpg';
  233.       AmazonPage.Free;
  234.       break;
  235.     end
  236.    else
  237.    if FindLine('DVD Search Results: we were unable to find exact matches for your search for',AmazonPage,1) <> -1 then
  238.     begin
  239.       ShowMessage('tuu');
  240.       AmazonPage.Free;
  241.       break;
  242.     end
  243.    else
  244.     if (FindLine('Below are results for',AmazonPage,1) <> -1) OR
  245.        (FindLine('All results',AmazonPage,1) <> -1) OR
  246.        (FindLine('Most popular results for',AmazonPage,1) <> -1) then
  247.         begin
  248.         i := 1;
  249.         CoverNum := 0;
  250.         AmazonPage.Text := GetStringFromHTML(AmazonPage.Text,'<b>Sort by:</b>','','<img src="http://g-images.amazon.com/images/G/01/associates/transparent-pixel.gif" width=1 height=1 vspace="0" hspace="0">',0);
  251.         PickTreeClear;
  252.         PickTreeAdd('Ok│adki:','');
  253.         while (i <= AmazonPage.Count-1) do
  254.         begin
  255.           THolder := AmazonPage.GetString(i);
  256.           HTMLRemoveTags(THolder);
  257.           if (Pos('/exec/obidos/ASIN/',AmazonPage.GetString(i)) <> 0) and
  258.              (THolder <> '') and
  259.              (Pos('Buy new',AmazonPage.GetString(i)) = 0) and
  260.              (Pos('Used & new from',AmazonPage.GetString(i)) = 0) and
  261.              (Pos('THUMBZZZ',AmazonPage.GetString(i)) = 0) and
  262.              (Pos('dvd-no-image',AmazonPage.GetString(i-4)) = 0) then begin
  263.                 PickTreeAdd(THolder,GetToken(AmazonPage.GetString(i),'/',5));
  264.                 CoverNum := CoverNum + 1;
  265.                 end;
  266.           if (Pos('/exec/obidos/tg/detail/',AmazonPage.GetString(i)) <> 0) and
  267.              (THolder <> '') and
  268.              (Pos('Buy new',AmazonPage.GetString(i)) = 0) and
  269.              (Pos('Used & new from',AmazonPage.GetString(i)) = 0) and
  270.              (Pos('THUMBZZZ',AmazonPage.GetString(i)) = 0) and
  271.              (Pos('http://www.amazon.com',AmazonPage.GetString(i)) = 0) and
  272.              (Pos('In-store Pickup',AmazonPage.GetString(i)) = 0) and
  273.              (Pos('dvd-no-image',AmazonPage.GetString(i-4)) = 0) then begin
  274.                 PickTreeAdd(THolder,GetToken(AmazonPage.GetString(i),'/',7));
  275.                 CoverNum := CoverNum + 1;
  276.                 end;
  277.           i := i + 1;
  278.         end
  279.         //ShowMessage(FloatToStr(CoverNum));
  280.         if CoverNum > 0 then begin
  281.         if PickTreeExec(THolder) then
  282.         begin
  283.           AmazonImageImport := 'http://images.amazon.com/images/P/' + THolder + '.01.LZZZZZZZ.jpg';
  284.           AmazonPage.Free;
  285.           break;
  286.         end
  287.         end
  288.         AmazonPage.Free;
  289.         break;
  290.       end
  291.     else
  292. AmazonPage.Free;
  293. end;
  294.  
  295. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  296. var
  297.   i: Integer;
  298. begin
  299.   Result := -1;
  300.   if StartAt < 0 then
  301.     StartAt := 0;
  302.   for i := StartAt to List.Count-1 do
  303.     if Pos(Pattern, List.GetString(i)) <> 0 then
  304.     begin
  305.       Result := i;
  306.       Break;
  307.     end;
  308. end;
  309.  
  310. function GetToken(aString, SepChar: String; TokenNum: Integer):String;
  311. var
  312.    Token     : string;
  313.    StrLen    : Integer;
  314.    TNum      : Integer;
  315.    TEnd      : Integer;
  316.  
  317. begin
  318.      StrLen := Length(aString);
  319.      TNum   := 1;
  320.      TEnd   := StrLen;
  321.      while ((TNum <= TokenNum) and (TEnd <> 0)) do
  322.      begin
  323.           TEnd := Pos(SepChar,aString);
  324.           if TEnd <> 0 then
  325.           begin
  326.                Token := Copy(aString,1,TEnd-1);
  327.                Delete(aString,1,TEnd);
  328.                TNum := TNum + 1;
  329.           end
  330.           else
  331.           begin
  332.                Token := aString;
  333.           end;
  334.      end;
  335.      if TNum >= TokenNum then
  336.      begin
  337.           GetToken := Token;
  338.      end
  339.      else
  340.      begin
  341.           GetToken := '';
  342.      end;
  343. end;
  344.  
  345. function AsinParse(Line : string): string;
  346. begin
  347.   Result := GetToken(GetToken(Line,'.',2),Chr(34),1);
  348. end;
  349.  
  350. procedure RemovePronoun(var Str: string);
  351. var
  352.   i: Integer;
  353.   s: string;
  354.   c: char;
  355. begin
  356.   // remove pronouns
  357.   if (Copy(Str, 0, 2) = 'L ') or (Copy(Str, 0, 2) = 'A ') then
  358.     Str := Copy(Str, 3, Length(Str) - 2)
  359.   else if (Copy(Str, 0, 3) = 'Le ') or (Copy(Str, 0, 3) = 'La ') or (Copy(Str, 0, 3) = 'Un ') then
  360.     Str := Copy(Str, 4, Length(Str) - 3)
  361.   else if (Copy(Str, 0, 4) = 'Les ') or (Copy(Str, 0, 4) = 'Une ') or (Copy(Str, 0, 4) = 'The ') then
  362.     Str := Copy(Str, 5, Length(Str) - 4);
  363.  
  364.   Str := StringReplaceAll(Str, '_', ' ');
  365.   // remove non-letters, non-digits and non-spaces
  366.   // polish diacritics chars are allowed
  367.   s := '';
  368.   for i := 1 to Length(Str) do begin
  369.   c := StrGet(Str, i);
  370.     if ((c<'a') or (c>'z')) and
  371.        ((c<'A') or (c>'Z')) and
  372.        ((c<'0') or (c>'9')) and
  373.        (c<>' ') and (c<>'╣') and
  374.        (c<>'Ñ') and (c<>'Ω') and
  375.        (c<>'╩') and (c<>'µ') and
  376.        (c<>'╞') and (c<>'£') and
  377.        (c<>'î') and (c<>'┐') and
  378.        (c<>'»') and (c<>'ƒ') and
  379.        (c<>'Å') and (c<>'≤') and
  380.        (c<>'╙') and (c<>'│') and
  381.        (c<>'ú') and (c<>'±') and
  382.        (c<>'╤') then
  383.     else
  384.       s := s + Copy(Str, i, 1);
  385.   end;
  386.   Str := s;
  387. end;
  388.  
  389. begin
  390.   if CheckVersion(3,4,1) then begin
  391.     SetOPT();
  392.     MovieName := GetField(fieldOriginalTitle);
  393.     if MovieName = '' then MovieName := GetField(fieldTranslatedTitle);
  394.     RemovePronoun(MovieName);
  395.     if Input('Stopklatka.pl Import', 'Podaj tytu│ filmu (tylko litery,cyfry i spacje):', MovieName) then
  396.       AnalyzePage('http://www.stopklatka.pl/szukaj/szukaj.asp?szukaj=' + URLEncode(MovieName) + '&kategoria=film&submit=Szukaj')
  397.   end else ShowMessage('Minimalne wymagania skryptu: wersja 3.4.1 programu Ant Movie Catalog.');
  398. end.
  399.